home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / HANDLES.ZIP / HANDLES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-23  |  31.0 KB  |  959 lines

  1. unit Handles;
  2.  
  3. { TStretchHandles is a transparent control to implement runtime grab handles
  4.   for Forms Designer-like projects.  It paints the handles on its own canvas,
  5.   maintains a list of the controls it is supposed to manage, and traps mouse
  6.   and keyboard events to move/resize itself and its child controls.  See the
  7.   accompanying README file for more information.
  8.  
  9.   Distributed by the author as freeware, please do not sell.
  10.  
  11.   Anthony Scott
  12.   CIS: 75567,3547                                                              }
  13.  
  14. interface
  15.  
  16. uses
  17.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  18.   Forms, Menus, StdCtrls, Dialogs;
  19.                                        { miscellaneous type declarations }
  20. type
  21.   TDragStyle = (dsMove, dsSizeTopLeft, dsSizeTopRight, dsSizeBottomLeft, dsSizeBottomRight,
  22.                 dsSizeTop, dsSizeLeft, dsSizeBottom, dsSizeRight);
  23.   TForwardMessage = (fmMouseDown, fmMouseUp);
  24.   GridValues = 1..32;
  25.   EBadChild = class(Exception);
  26.                                        { TStretchHandle component declaration }
  27. type
  28.   TStretchHandle = class(TCustomControl)
  29.   private
  30.     FDragOffset: TPoint;
  31.     FDragStyle: TDragStyle;
  32.     FDragging: boolean;
  33.     FDragRect: TRect;
  34.     FLocked: boolean;
  35.     FPrimaryColor: TColor;
  36.     FSecondaryColor: TColor;
  37.     FGridX, FGridY: GridValues;
  38.     FChildList: TList;
  39.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  40.     procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
  41.     procedure Rubberband(XPos, YPos: integer; ShowBox: boolean);
  42.     procedure ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  43.     procedure SetPrimaryColor(Color: TColor);
  44.     procedure SetSecondaryColor(Color: TColor);
  45.     procedure SetGridState(Value: boolean);
  46.     function GetGridState: boolean;
  47.     function GetChildCount: integer;
  48.     function GetChildControl(idx: integer): TControl;
  49.     function GetModifiedRect(XPos, YPos: integer): TRect;
  50.     function PointOverChild(P: TPoint): boolean;
  51.     function XGridAdjust(X: integer): integer;
  52.     function YGridAdjust(Y: integer): integer;
  53.     function IsAttached: boolean;
  54.   protected
  55.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  56.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  57.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  58.     procedure KeyDown(var key: Word; Shift: TShiftState); override;
  59.     procedure CreateParams(var Params: TCreateParams); override;
  60.     procedure Paint; override;
  61.     property Canvas;
  62.   public
  63.     constructor Create(AOwner: TComponent); override;
  64.     destructor Destroy; override;
  65.     procedure Attach(ChildControl: TControl);
  66.     procedure Detach;
  67.     procedure ReleaseChild(ChildControl: TControl);
  68.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  69.     procedure BringToFront;
  70.     procedure SendToBack;
  71.     procedure SetColors(Color1, Color2: TColor);
  72.     function IndexOf(ChildControl: TControl): integer;
  73.                                        { new run-time only properties }
  74.     property Attached: boolean read IsAttached;
  75.     property ChildCount: integer read GetChildCount;
  76.     property Children[idx: integer]: TControl read GetChildControl;
  77.   published
  78.                                        { new properties }
  79.     property Color: TColor read FPrimaryColor write SetPrimaryColor default clBlack;
  80.     property SecondaryColor: TColor read FSecondaryColor write SetSecondaryColor default clGray;
  81.     property Locked: boolean read FLocked write FLocked default False;
  82.     property GridX: GridValues read FGridX write FGridX default 8;
  83.     property GridY: GridValues read FGridY write FGridY default 8;
  84.     property SnapToGrid: boolean read GetGridState write SetGridState default False;
  85.                                        { inherited properties }
  86.     property DragCursor;
  87.     property Enabled;
  88.     property Hint;
  89.     property ParentShowHint;
  90.     property PopupMenu;
  91.     property ShowHint;
  92.     property Visible;
  93.                                        { defined events }
  94.     property OnClick;
  95.     property OnDblClick;
  96.     property OnMouseDown;
  97.     property OnMouseMove;
  98.     property OnMouseUp;
  99.     property OnKeyDown;
  100.     property OnKeyUp;
  101.     property OnKeyPress;
  102.   end;
  103.  
  104. procedure Register;
  105. function MinInt(a, b: integer): integer;
  106. function MaxInt(a, b: integer): integer;
  107.  
  108. implementation
  109.  
  110. procedure Register;
  111. begin
  112.                                        { add the component to the 'Samples' tab }
  113.   RegisterComponents('Samples', [TStretchHandle]);
  114.  
  115. end;
  116.  
  117. constructor TStretchHandle.Create(AOwner: TComponent);
  118. begin
  119.  
  120.   inherited Create(AOwner);
  121.                                        { create storage for child objects }
  122.   FChildList := TList.Create;
  123.                                        { initialize default properties }
  124.   Width := 24;
  125.   Height := 24;
  126.   FPrimaryColor := clBlack;
  127.   FSecondaryColor := clGray;
  128.                                        { a value of 1 is used to effectively disable the snap-to grid }
  129.   FGridX := 1;
  130.   FGridY := 1;
  131.                                        { doesn't do anything until it is Attached to something else }
  132.   Enabled := False;
  133.   Visible := False;
  134.  
  135. end;
  136.  
  137. destructor TStretchHandle.Destroy;
  138. begin
  139.                                        { tidy up carefully }                                                                
  140.   FChildList.Free;
  141.   inherited Destroy;
  142.  
  143. end;
  144.  
  145. procedure TStretchHandle.CreateParams(var Params: TCreateParams);
  146. begin
  147.                                        { set default Params values }
  148.   inherited CreateParams(Params);
  149.                                        { then add transparency; ensures correct repaint order }
  150.   Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
  151.  
  152. end;
  153.  
  154. procedure TStretchHandle.WMGetDLGCode(var Message: TMessage);
  155. begin
  156.                                        { get arrow key press events }
  157.   Message.Result := DLGC_WANTARROWS;
  158.  
  159. end;
  160.  
  161. procedure TStretchHandle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  162. begin
  163.                                        { completely fake erase, don't call inherited, don't collect $200 }
  164.   Message.Result := 1;
  165.  
  166. end;
  167.  
  168. procedure TStretchHandle.Attach(ChildControl: TControl);
  169. var
  170.   L, T, W, H: integer;
  171. begin
  172.                                        { definitely not allowed! }
  173.   if ChildControl is TForm then
  174.     raise EBadChild.Create('Handles can not be attached to a Form!');
  175.                                        { add child component to unique list managed by TStretchHandle }
  176.   if (ChildControl <> nil) and (FChildList.IndexOf(TObject(ChildControl)) = -1) then
  177.     begin
  178.                                        { make sure new child's Parent matches siblings }
  179.       if (FChildList.Count > 0) and (ChildControl.Parent <> Parent) then
  180.         Detach;
  181.                                        { initialize when first child is attached }
  182.       if FChildList.Count = 0 then
  183.         begin
  184.           Parent := ChildControl.Parent;
  185.                                        { only make it visible now, to avoid color flashing, & accept events }
  186.           FDragRect := Rect(0, 0, 0, 0);
  187.           Enabled := True;
  188.           Visible := True;
  189.           inherited SetBounds(ChildControl.Left - 2, ChildControl.Top - 2, ChildControl.Width + 5, ChildControl.Height + 5);
  190.  
  191.         end
  192.       else
  193.         begin
  194.                                        { set size to bound all children, plus room for handles }
  195.           L := MinInt(Left, ChildControl.Left - 2);
  196.           T := MinInt(Top, ChildControl.Top - 2);
  197.           W := Maxint(Left + Width - 3, ChildControl.Left + ChildControl.Width) - L + 3;
  198.           H := Maxint(Top + Height - 3, ChildControl.Top + ChildControl.Height) - T + 3;
  199.           inherited SetBounds(L, T, W, H);
  200.  
  201.         end;
  202.                                        { add to list of active Children }
  203.       FChildList.Add(TObject(ChildControl));
  204.                                        { re-set DragStyle }
  205.       FDragStyle := dsMove;
  206.                                        { use old BringToFront so as not to change Child's Z-order }
  207.       if not (csDesigning in ComponentState) then
  208.         begin
  209.           inherited BringToFront;
  210.                                        { allow us to get Mouse events immediately! }
  211.           SetCapture(Handle);
  212.                                        { get keyboard events }
  213.           if Visible and Enabled then
  214.             SetFocus;
  215.         end;
  216.  
  217.     end;
  218.  
  219. end;
  220.  
  221. procedure TStretchHandle.Detach;
  222. begin
  223.                                        { remove all Child components from list }
  224.   if FChildList.Count > 0 then
  225.     with FChildList do
  226.       repeat
  227.         Delete(0);
  228.       until Count = 0;
  229.                                        { disable & hide StretchHandle }
  230.   FLocked := False;
  231.   Width := 24;
  232.   Height := 24;
  233.   Enabled := False;
  234.   Visible := False;
  235.   Parent := nil;
  236.   FDragRect := Rect(0, 0, 0, 0);
  237.  
  238. end;
  239.  
  240. procedure TStretchHandle.ReleaseChild(ChildControl: TControl);
  241. var
  242.   idx, L, T, W, H: integer;
  243.   AControl: TControl;
  244. begin
  245.                                        { delete the Child if it exists in the list }
  246.   idx := FChildList.IndexOf(TObject(ChildControl));
  247.   if (ChildControl <> nil) and (idx >= 0) then
  248.     FChildList.Delete(idx);
  249.                                        { disable & hide StretchHandle if no more children }
  250.   if FChildList.Count = 0 then
  251.     begin
  252.       FLocked := False;
  253.       Enabled := False;
  254.       Visible := False;
  255.       Parent := nil;
  256.       FDragRect := Rect(0, 0, 0, 0);
  257.     end
  258.   else
  259.     begin
  260.                                        { set size to bound remaining children, plus room for handles }
  261.       L := TControl(FChildList.Items[0]).Left - 2;
  262.       T := TControl(FChildList.Items[0]).Top - 2;
  263.       W := TControl(FChildList.Items[0]).Width + 3;
  264.       H := TControl(FChildList.Items[0]).Height + 3;
  265.  
  266.       for idx := 0 to FChildList.Count - 1 do
  267.         begin
  268.           AControl := TControl(FChildList.Items[idx]);
  269.           L := MinInt(L, AControl.Left - 2);
  270.           T := MinInt(T, AControl.Top - 2);
  271.           W := Maxint(L + W - 3, AControl.Left + AControl.Width) - L + 3;
  272.           H := Maxint(T + H - 3, AControl.Top + AControl.Height) - T + 3;
  273.         end;
  274.  
  275.       inherited SetBounds(L, T, W, H);
  276.  
  277.     end;
  278.  
  279. end;
  280.  
  281. function TStretchHandle.IndexOf(ChildControl: TControl): integer;
  282. begin
  283.                                        { simply pass on the result... }
  284.   Result := FChildList.IndexOf(TObject(ChildControl));
  285.  
  286. end;
  287.  
  288. procedure TStretchHandle.BringToFront;
  289. var
  290.   i: integer;
  291. begin
  292.                                        { do nothing if not Attached }
  293.   if Attached and not Locked then
  294.     begin
  295.                                        { take care of Children first, in Attach order }
  296.       for i := 0 to FChildList.Count - 1 do
  297.         begin
  298.           TControl(FChildList[i]).BringToFront;
  299.         end;
  300.                                        { make sure keyboard focus is restored }
  301.       inherited BringToFront;
  302.       if Visible and Enabled then
  303.         SetFocus;
  304.     end;
  305.  
  306. end;
  307.  
  308. procedure TStretchHandle.SendToBack;
  309. var
  310.   i: integer;
  311. begin
  312.                                        { do nothing if not Attached }
  313.   if Attached and not Locked then
  314.     begin
  315.                                        { take care of Children first, in Attach order }
  316.       for i := 0 to FChildList.Count - 1 do
  317.         begin
  318.           TControl(FChildList[i]).SendToBack;
  319.         end;
  320.                                        { Handles stay in front of everything, always }
  321.       inherited BringToFront;
  322.       if Visible and Enabled then
  323.         SetFocus;
  324.     end;
  325.  
  326. end;
  327.  
  328. procedure TStretchHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  329. begin
  330.                                        { only process MouseDown if it is over a Child, else forward }
  331.   if PointOverChild(Point(Left + X, Top + Y)) then
  332.     begin
  333.       if (Button = mbLeft) and not FLocked then
  334.         begin
  335.           FDragOffset := Point(X, Y);
  336.           FDragging := True;
  337.         end;
  338.       inherited MouseDown(Button, Shift, X, Y);
  339.     end
  340.   else
  341.     begin
  342.       Cursor := crDefault;
  343.       SetCursor(Screen.Cursors[Cursor]);
  344.       ForwardMessage(fmMouseDown, Button, Shift, Left + X, Top + Y);
  345.     end;
  346.  
  347. end;
  348.  
  349. procedure TStretchHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  350. var
  351.   ARect: TRect;
  352. begin
  353.                                        { resize, reposition if anything changed }
  354.   if FDragging and (Button = mbLeft) then
  355.     begin
  356.                                        { disallow drop off Parent }
  357.       if (Left + X) < 0 then
  358.         X := -Left;
  359.       if (Top + Y) < 0 then
  360.         Y := -Top;
  361.       if (Left + X) > Parent.Width then
  362.         X := Parent.Width - Left;
  363.       if (Top + Y) > Parent.Height then
  364.         Y := Parent.Height - Top;
  365.                                        { force Paint when size doesn't change but position does }
  366.       if (X <> FDragOffset.X) or (Y <> FDragOffset.Y) then
  367.         begin
  368.           Invalidate;
  369.           ARect := GetModifiedRect(X, Y);
  370.           SetBounds(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  371.         end;
  372.                                        { clear drag outline }
  373.       RubberBand(0, 0, False);
  374.                                        { seem to need this for keyboard events }
  375.       if Visible and Enabled then
  376.         SetFocus;
  377.  
  378.       FDragging := False;
  379.       Cursor := crDefault;
  380.       ReleaseCapture;
  381.                                        { perform default processing }
  382.       inherited MouseUp(Button, Shift, X, Y);
  383.  
  384.     end
  385.   else
  386.     ForwardMessage(fmMouseUp, Button, Shift, Left + X, Top + Y);
  387.  
  388. end;
  389.  
  390. procedure TStretchHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
  391. var
  392.   ARect: TRect;
  393.   DragStyle: TDragStyle;
  394. begin
  395.                                        { this may be a move immediately on Attach instead of MouseDown }
  396.   if (ssLeft in Shift) and not FDragging and not FLocked then
  397.     begin
  398.       FDragOffset := Point(X, Y);
  399.       FDragging := True;
  400.     end
  401.                                        { only recognize move after simulated MouseDown }
  402.   else
  403.     begin
  404.                                        { let's not hog mouse events unnecessarily } 
  405.       if not (ssLeft in Shift) then
  406.         ReleaseCapture;
  407.                                        { default to drag cursor only when dragging }
  408.       DragStyle := dsMove;
  409.       Cursor := crDefault;
  410.                                        { disallow resize if multiple children }
  411.       if FChildList.Count = 1 then
  412.         begin
  413.  
  414.           ARect := GetClientRect;
  415.                                        { so I don't like long nested if statements... }
  416.           if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Top) < 5)) then
  417.             begin
  418.               DragStyle := dsSizeTopLeft;
  419.               Cursor := crSizeNWSE;
  420.             end;
  421.  
  422.           if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
  423.             begin
  424.               DragStyle := dsSizeBottomRight;
  425.               Cursor := crSizeNWSE;
  426.             end;
  427.  
  428.           if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Top) < 5)) then
  429.             begin
  430.               DragStyle := dsSizeTopRight;
  431.               Cursor := crSizeNESW;
  432.             end;
  433.  
  434.           if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
  435.             begin
  436.               DragStyle := dsSizeBottomLeft;
  437.               Cursor := crSizeNESW;
  438.             end;
  439.  
  440.           if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Top) < 5)) then
  441.             begin
  442.               DragStyle := dsSizeTop;
  443.               Cursor := crSizeNS;
  444.             end;
  445.  
  446.           if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Bottom) < 5)) then
  447.             begin
  448.               DragStyle := dsSizeBottom;
  449.               Cursor := crSizeNS;
  450.             end;
  451.  
  452.           if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Left) < 5)) then
  453.             begin
  454.               DragStyle := dsSizeLeft;
  455.               Cursor := crSizeWE;
  456.             end;
  457.  
  458.           if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Right) < 5)) then
  459.             begin
  460.               DragStyle := dsSizeRight;
  461.               Cursor := crSizeWE;
  462.             end;
  463.  
  464.         end;
  465.                                        { if position-locked, override cursor change }
  466.       if FLocked then
  467.         Cursor := crNoDrop;
  468.  
  469.       if FDragging then
  470.         begin
  471.                                        { disallow drag off Parent }
  472.           if (Left + X) < 0 then
  473.             X := -Left;
  474.           if (Top + Y) < 0 then
  475.             Y := -Top;
  476.           if (Left + X) > Parent.Width then
  477.             X := Parent.Width - Left;
  478.           if (Top + Y) > Parent.Height then
  479.             Y := Parent.Height - Top;
  480.                                        { display cursor & drag outline }
  481.           if FDragStyle = dsMove then
  482.             Cursor := DragCursor;
  483.           SetCursor(Screen.Cursors[Cursor]);
  484.           RubberBand(X, Y, True);
  485.  
  486.         end
  487.       else
  488.         FDragStyle := DragStyle;
  489.  
  490.   end;
  491.                                        { perform default processing }
  492.   inherited MouseMove(Shift, X, Y);
  493.  
  494. end;
  495.  
  496. procedure TStretchHandle.ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  497. var
  498.   i: integer;
  499.   Found: boolean;
  500.   Msg: Word;
  501.   ARect: TRect;
  502.   AControl: TControl;
  503.   AMessage: TMessage;
  504. begin
  505.                                        { construct the message to be sent }
  506.   case FwdMsg of
  507.     fmMouseDown:
  508.       case Button of
  509.         mbLeft:
  510.           Msg := WM_LBUTTONDOWN;
  511.         mbMiddle:
  512.           Msg := WM_MBUTTONDOWN;
  513.         mbRight:
  514.           Msg := WM_RBUTTONDOWN;
  515.       end;
  516.     fmMouseUp:
  517.       case Button of
  518.         mbLeft:
  519.           Msg := WM_LBUTTONUP;
  520.         mbMiddle:
  521.           Msg := WM_MBUTTONUP;
  522.         mbRight:
  523.           Msg := WM_RBUTTONUP;
  524.       end;
  525.   end;
  526.  
  527.   AMessage.WParam := 0;
  528.                                        { determine whether X, Y is over any other windowed control }
  529.   Found := False;
  530.   for i := 0 to Parent.ControlCount - 1 do
  531.     begin
  532.       AControl := TControl(Parent.Controls[i]);
  533.       if (AControl is TWinControl) and not (AControl is TStretchHandle) then
  534.         begin
  535.           ARect := Rect(AControl.Left,
  536.                         AControl.Top,
  537.                         AControl.Left + AControl.Width,
  538.                         AControl.Top + AControl.Height);
  539.                                         { X, Y are relative to Parent }
  540.           if PtInRect(ARect, Point(X, Y)) then
  541.             begin
  542.               Found := True;
  543.               break;
  544.             end;
  545.         end;
  546.     end;
  547.                                         { forward the message to the control if found, else to the Parent }
  548.   if Found then
  549.     begin
  550.       AMessage.LParamLo := X - AControl.Left;
  551.       AMessage.LParamHi := Y - AControl.Top;
  552.       SendMessage(TWinControl(AControl).Handle, Msg, AMessage.WParam, AMessage.LParam);
  553.     end
  554.   else
  555.     begin
  556.       AMessage.LParamLo := X;
  557.       AMessage.LParamHi := Y;
  558.       SendMessage(Parent.Handle, Msg, AMessage.WParam, AMessage.LParam);
  559.     end;
  560.  
  561. end;
  562.  
  563. procedure TStretchHandle.KeyDown(var Key: Word; Shift: TShiftState);
  564. begin
  565.                                        { process arrow keys to move/resize Handles & Child, also move siblings }
  566.   case Key of
  567.     VK_UP:
  568.       begin
  569.         Invalidate;
  570.         SetBounds(Left, Top - 1, Width, Height);
  571.       end;
  572.     VK_DOWN:
  573.       begin
  574.         Invalidate;
  575.         SetBounds(Left, Top + 1, Width, Height);
  576.       end;
  577.     VK_LEFT:
  578.       begin
  579.         Invalidate;
  580.         SetBounds(Left - 1, Top, Width, Height);
  581.       end;
  582.     VK_RIGHT:
  583.       begin
  584.         Invalidate;
  585.         SetBounds(Left + 1, Top, Width, Height);
  586.       end;
  587.   end;
  588.  
  589.   inherited KeyDown(Key, Shift);
  590.  
  591. end;
  592.  
  593. function TStretchHandle.GetModifiedRect(XPos, YPos: integer): TRect;
  594. var
  595.   ARect: TRect;
  596. begin
  597.                                        { compute new position/size, depending on FDragStyle}
  598.   case FDragStyle of
  599.  
  600.     dsSizeTopLeft:
  601.       begin
  602.         ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
  603.         ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
  604.         ARect.Right := Width - (ARect.Left - Left);
  605.         ARect.Bottom := Height - (ARect.Top - Top);
  606.       end;
  607.  
  608.     dsSizeTopRight:
  609.       begin
  610.         ARect.Left := Left;
  611.         ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
  612.         ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
  613.         ARect.Bottom := Height - (ARect.Top - Top);
  614.       end;
  615.  
  616.     dsSizeBottomLeft:
  617.       begin
  618.         ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
  619.         ARect.Top := Top;
  620.         ARect.Right := Width - (ARect.Left - Left);
  621.         ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
  622.       end;
  623.  
  624.     dsSizeBottomRight:
  625.       begin
  626.         ARect.Left := Left;
  627.         ARect.Top := Top;
  628.         ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
  629.         ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
  630.       end;
  631.  
  632.     dsSizeTop:
  633.       begin
  634.         ARect.Left := Left;
  635.         ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
  636.         ARect.Right := Width;
  637.         ARect.Bottom := Height - (ARect.Top - Top);
  638.       end;
  639.  
  640.     dsSizeBottom:
  641.       begin
  642.         ARect.Left := Left;
  643.         ARect.Top := Top;
  644.         ARect.Right := Width;
  645.         ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
  646.       end;
  647.  
  648.     dsSizeLeft:
  649.       begin
  650.         ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
  651.         ARect.Top := Top;
  652.         ARect.Right := Width - (ARect.Left - Left);
  653.         ARect.Bottom := Height;
  654.       end;
  655.  
  656.     dsSizeRight:
  657.       begin
  658.         ARect.Left := Left;
  659.         ARect.Top := Top;
  660.         ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
  661.         ARect.Bottom := Height;
  662.       end;
  663.  
  664.   else
  665.                                        { keep size, move to new position }
  666.     ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
  667.     ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
  668.     ARect.Right := Width;
  669.     ARect.Bottom := Height;
  670.  
  671.   end;
  672.                                        { impose a minimum size for sanity }
  673.   if ARect.Right < 5 then
  674.     ARect.Right := 5;
  675.   if ARect.Bottom < 5 then
  676.     ARect.Bottom := 5;
  677.  
  678.   Result := ARect;
  679.  
  680. end;
  681.  
  682. procedure TStretchHandle.Rubberband(XPos, YPos: integer; ShowBox: boolean);
  683. var
  684.   NewRect: TRect;
  685.   PtA, PtB: TPoint;
  686.   ScreenDC: HDC;
  687. begin
  688.                                        { outline is drawn over all windows }
  689.   ScreenDC := GetDC(0);
  690.                                        { erase previous rectangle, if any, & adjust for handle's position }
  691.   if (FDragRect.Left <> 0) or (FDragRect.Top <> 0) or (FDragRect.Right <> 0) or (FDragRect.Bottom <> 0) then
  692.     begin
  693.       PtA := Parent.ClientToScreen(Point(FDragRect.Left + 2, FDragRect.Top + 2));
  694.       PtB := Parent.ClientToScreen(Point(FDragRect.Left + FDragRect.Right - 3, FDragRect.Top + FDragRect.Bottom - 3));
  695.       DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
  696.       FDragRect := Rect(0, 0, 0, 0);
  697.     end;
  698.                                        { draw new rectangle unless this is a final erase }
  699.   if ShowBox then
  700.     begin
  701.       NewRect := GetModifiedRect(XPos, YPos);
  702.       PtA := Parent.ClientToScreen(Point(NewRect.Left + 2, NewRect.Top + 2));
  703.       PtB := Parent.ClientToScreen(Point(NewRect.Left + NewRect.Right - 3, NewRect.Top + NewRect.Bottom - 3));
  704.       DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
  705.       FDragRect := NewRect;
  706.     end
  707.   else
  708.     begin
  709.       Parent.Repaint;
  710.       Repaint;
  711.     end;
  712.  
  713.   ReleaseDC(0, ScreenDC);
  714.  
  715. end;
  716.  
  717. procedure TStretchHandle.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  718. var
  719.   WasVisible: boolean;
  720.   i: integer;
  721.   AControl: TControl;
  722. begin
  723.                                        { hide & preserve fixed size in design mode }
  724.   WasVisible := Visible;
  725.   if csDesigning in ComponentState then
  726.     begin
  727.       Visible := False;
  728.       inherited SetBounds(ALeft, ATop, 24, 24);
  729.     end
  730.   else                                 { move child also, if any (but only if not locked) }
  731.     if not FLocked then
  732.       begin
  733.         for i := 0 to FChildList.Count - 1 do
  734.           begin
  735.             AControl := FChildList[i];
  736.             AControl.SetBounds(AControl.Left - Left + ALeft,
  737.                                AControl.Top - Top + ATop,
  738.                                AControl.Width - Width + AWidth,
  739.                                AControl.Height - Height + AHeight);
  740.           end;
  741.         inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  742.       end;
  743.                                        { restore visibility }
  744.   if Visible = False then
  745.     Visible := WasVisible;
  746.  
  747. end;
  748.  
  749. procedure TStretchHandle.Paint;
  750. var
  751.    AControl: TControl;
  752.    ARect, BoxRect: TRect;
  753.    i: integer;
  754. begin
  755.  
  756.   inherited Paint;
  757.                                         { do it differently at design time... }
  758.   if csDesigning in ComponentState then
  759.     begin
  760.       Canvas.Brush.Color := FPrimaryColor;
  761.       BoxRect := Rect(0, 0, 5, 5);
  762.       Canvas.FillRect(BoxRect);
  763.       BoxRect := Rect(19, 0, 24, 5);
  764.       Canvas.FillRect(BoxRect);
  765.       BoxRect := Rect(19, 19, 24, 24);
  766.       Canvas.FillRect(BoxRect);
  767.       BoxRect := Rect(0, 19, 5, 24);
  768.       Canvas.FillRect(BoxRect);
  769.     end
  770.   else
  771.     begin
  772.                                        { set color to primary if only one child, else secondary }
  773.       if FChildList.Count = 1 then
  774.         Canvas.Brush.Color := FPrimaryColor
  775.       else
  776.         Canvas.Brush.Color := FSecondaryColor;
  777.                                        { draw resize handles for each child }
  778.       for i := 0 to FChildList.Count - 1 do
  779.         begin
  780.  
  781.           AControl := TControl(FChildList.Items[i]);
  782.           ARect := Rect(AControl.Left - Left - 2,
  783.                         AControl.Top - Top - 2,
  784.                         AControl.Left - Left + AControl.Width + 2,
  785.                         AControl.Top - Top + AControl.Height + 2);
  786.  
  787.           with Canvas do
  788.             begin
  789.                                        { draw corner boxes (assuming Canvas is minimum 5x5) }
  790.               BoxRect := Rect(ARect.Left, ARect.Top, ARect.Left + 5, ARect.Top + 5);
  791.               FillRect(BoxRect);
  792.               BoxRect := Rect(ARect.Right - 5, ARect.Top, ARect.Right, ARect.Top + 5);
  793.               FillRect(BoxRect);
  794.               BoxRect := Rect(ARect.Right - 5, ARect.Bottom - 5, ARect.Right, ARect.Bottom);
  795.               FillRect(BoxRect);
  796.               BoxRect := Rect(ARect.Left, ARect.Bottom - 5, ARect.Left + 5, ARect.Bottom);
  797.               FillRect(BoxRect);
  798.                                        { only for single Children, draw center boxes }
  799.               if FChildList.Count = 1 then
  800.                 begin
  801.                   BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
  802.                                   ARect.Top,
  803.                                   ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
  804.                                   ARect.Top + 5);
  805.                   FillRect(BoxRect);
  806.                   BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
  807.                                   ARect.Bottom - 5,
  808.                                   ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
  809.                                   ARect.Bottom);
  810.                   FillRect(BoxRect);
  811.                   BoxRect := Rect(ARect.Left,
  812.                                   ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
  813.                                   ARect.Left + 5,
  814.                                   ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
  815.                   FillRect(BoxRect);
  816.                   BoxRect := Rect(ARect.Right - 5,
  817.                                   ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
  818.                                   ARect.Right,
  819.                                   ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
  820.                   FillRect(BoxRect);
  821.                 end;
  822.  
  823.             end;
  824.  
  825.         end;
  826.  
  827.     end;
  828.  
  829. end;
  830.  
  831. procedure TStretchHandle.SetPrimaryColor(Color: TColor);
  832. begin
  833.                                        { set single select color, repaint immediately }
  834.   FPrimaryColor := Color;
  835.   Repaint;
  836.  
  837. end;
  838.  
  839. procedure TStretchHandle.SetSecondaryColor(Color: TColor);
  840. begin
  841.                                        { set multiple select color, repaint immediately }
  842.   FSecondaryColor := Color;
  843.   Repaint;
  844.  
  845. end;
  846.  
  847. procedure TStretchHandle.SetColors(Color1, Color2: TColor);
  848. begin
  849.                                        { set single/multiple select colors, repaint }
  850.   FPrimaryColor := Color1;
  851.   FSecondaryColor := Color2;
  852.   Repaint;
  853.  
  854. end;
  855.  
  856. procedure TStretchHandle.SetGridState(Value: boolean);
  857. begin
  858.                                        { a value of 1 effectively disables a grid axis }
  859.   if Value then
  860.     begin
  861.       FGridX := 8;
  862.       FGridY := 8;
  863.     end
  864.   else
  865.     begin
  866.       FGridX := 1;
  867.       FGridY := 1;
  868.     end;
  869.  
  870. end;
  871.  
  872. function TStretchHandle.GetGridState: boolean;
  873. begin
  874.  
  875.   if (FGridX > 1) or (FGridY > 1) then
  876.     Result := True
  877.   else
  878.     Result := False;
  879.  
  880. end;
  881.  
  882. function TStretchHandle.GetChildCount: integer;
  883. begin
  884.   Result := FChildList.Count;
  885. end;
  886.  
  887. function TStretchHandle.GetChildControl(idx: integer): TControl;
  888. begin
  889.  
  890.   if (FChildList.Count > 0) and (idx >= 0) then
  891.     Result := FChildList[idx]
  892.   else
  893.     Result := nil;
  894.  
  895. end;
  896.  
  897. function TStretchHandle.IsAttached: boolean;
  898. begin
  899.  
  900.   if FChildList.Count > 0 then
  901.     Result := True
  902.   else
  903.     Result := False;
  904.  
  905. end;
  906.  
  907. function TStretchHandle.PointOverChild(P: TPoint): boolean;
  908. var
  909.   i: integer;
  910.   ARect: TRect;
  911.   AControl: TControl;
  912. begin
  913.                                        { determine whether X, Y is over any child (for dragging) }
  914.   Result := False;
  915.   for i := 0 to FChildList.Count - 1 do
  916.     begin
  917.       AControl := TControl(FChildList[i]);
  918.       ARect := Rect(AControl.Left - 2,
  919.                     AControl.Top - 2,
  920.                     AControl.Left + AControl.Width + 2,
  921.                     AControl.Top + AControl.Height + 2);
  922.                                        { P is relative to the Parent }
  923.       if PtInRect(ARect, P) then
  924.         begin
  925.           Result := True;
  926.           break;
  927.         end;
  928.     end;
  929.  
  930. end;
  931.  
  932. function TStretchHandle.XGridAdjust(X: integer): integer;
  933. begin
  934.   Result := (X DIV FGridX) * FGridX;
  935. end;
  936.  
  937. function TStretchHandle.YGridAdjust(Y: integer): integer;
  938. begin
  939.   Result := (Y DIV FGridY) * FGridY;
  940. end;
  941.  
  942. function MinInt(a, b: integer): integer;
  943. begin
  944.   if a < b then
  945.     Result := a
  946.   else
  947.     Result := b;
  948. end;
  949.  
  950. function MaxInt(a, b: integer): integer;
  951. begin
  952.   if a > b then
  953.     Result := a
  954.   else
  955.     Result := b;
  956. end;
  957.  
  958. end.
  959.